home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / ussbc23.zip / LIB16 / RPSSBC.PAS < prev    next >
Pascal/Delphi Source File  |  1996-07-24  |  4KB  |  131 lines
  1. {*************************************************************************}
  2. { ReportPrinter/SoftSector BarCode Component version 1.02                 }
  3. { Copyright (c), 1996, Nevrona Designs, all rights reserved               }
  4. {                                                                         }
  5. { This component is only useful if you own fully liscensed copies of both }
  6. { ReportPrinter Pro and ssBarcode.  See RPSSBC.TXT for more information   }
  7. { on the usage of this component and how to get more info on ssBarcode or }
  8. { ReportPrinter Pro.                                                      }
  9. {*************************************************************************}
  10.  
  11. unit RPSSBC;
  12.  
  13. interface
  14.  
  15. uses
  16.   Classes, SysUtils, Graphics, SSBC, RPDefine, RPBase;
  17.  
  18. type
  19.   TRPSSBarCode = class(TSSBarCode)
  20.   protected
  21.     BaseReport: TBaseReport;
  22.  
  23.     procedure CanvasMoveTo(Canvas: TCanvas;
  24.                            X,Y: integer); override;
  25.     procedure CanvasLineTo(Canvas: TCanvas;
  26.                            X,Y: integer); override;
  27.     procedure CanvasTextOutRotate(Canvas: TCanvas;
  28.                                   TheFont: TFont;
  29.                                   TheX,TheY: integer;
  30.                                   Angle: longint;
  31.                                   Text: string); override;
  32.   public
  33.     procedure PrintBarCode(ReportPrinter: TBaseReport;
  34.                            PrintX,PrintY: double;
  35.                            Height: double);
  36.   end; { TRPSSBarCode }
  37.  
  38. var
  39.   OutFile: text;
  40.  
  41.   procedure Register;
  42.  
  43. implementation
  44.  
  45.   procedure Register;
  46.  
  47.   begin { Register }
  48.     RegisterComponents('Report',[TRPSSBarcode]);
  49.   end;  { Register }
  50.  
  51.  
  52.   procedure TRPSSBarCode.CanvasMoveTo(Canvas: TCanvas;
  53.                                       X,Y: integer);
  54.  
  55.   begin
  56.     If Painting then begin
  57.       inherited CanvasMoveTo(Canvas,X,Y);
  58.     end else begin
  59.       With BaseReport do begin
  60.         MoveTo(XD2U(X),YD2U(Y));
  61.         Writeln(OutFile,'M:',X,',',Y,'-',XD2U(X),',',YD2U(Y));
  62.       end; { with }
  63.     end; { else }
  64.   end;
  65.  
  66.  
  67.   procedure TRPSSBarCode.CanvasLineTo(Canvas: TCanvas;
  68.                                       X,Y: integer);
  69.  
  70.   begin
  71.     If Painting then begin
  72.       inherited CanvasLineTo(Canvas,X,Y);
  73.     end else begin
  74.       With BaseReport do begin
  75.         LineTo(XD2U(X),YD2U(Y));
  76.         Writeln(OutFile,'L:',X,',',Y,'-',XD2U(X),',',YD2U(Y));
  77.       end; { with }
  78.     end; { else }
  79.   end;
  80.  
  81.  
  82.   procedure TRPSSBarCode.CanvasTextOutRotate(Canvas: TCanvas;
  83.                                              TheFont: TFont;
  84.                                              TheX,TheY: integer;
  85.                                              Angle: longint;
  86.                                              Text: string);
  87.  
  88.   begin
  89.     If Painting then begin
  90.       inherited CanvasTextOutRotate(Canvas,TheFont,TheX,TheY,Angle,Text);
  91.     end else begin
  92.       With BaseReport do begin
  93.         PushFont;
  94.         Canvas.Font := TheFont;
  95.         FontRotation := Angle;
  96.         FontTop := YD2U(TheY);
  97.         PrintLeft(Text,XD2U(TheX));
  98.         PopFont;
  99.       end; { with }
  100.     end; { else }
  101.   end;
  102.  
  103.  
  104.   procedure TRPSSBarCode.PrintBarCode(ReportPrinter: TBaseReport;
  105.                                       PrintX,PrintY: double;
  106.                                       Height: double);
  107.  
  108.   var
  109.     I1: integer;
  110.  
  111.   begin { PrintBarCode }
  112.     AssignFile(OutFile,'RPSSBC.DAT');
  113.     Rewrite(OutFile);
  114.     With ReportPrinter as TBaseReport do begin
  115.       CodeHeight := Round(YU2I(Height) * YDPI);
  116.       DataBits := CreateDatabits(XDPI);
  117.       AODataBits := CreateAODatabits(XDPI);
  118.       For I1 := 0 to StrLen(DataBits) do begin
  119.         Write(OutFile,DataBits[I1]);
  120.       end; { for }
  121.       Writeln(OutFile);
  122.       BaseReport := ReportPrinter;
  123.       DrawBarCode(Canvas,XU2D(PrintX),YU2D(PrintY),XDPI);
  124.       BaseReport := nil;
  125.     end; { with }
  126.     CloseFile(OutFile);
  127.   end;  { PrintBarCode }
  128.  
  129.  
  130. end.
  131.